home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Yerk 3.6.7 / yerk 367 / tool+ / savedlg < prev    next >
Text File  |  1994-10-10  |  5KB  |  140 lines
  1. \ Dialog subclass that saves an ascii representation of its data. Data may
  2. \ be changed
  3. \ 11.26.90    rfl    added clear: parms to release:  An error may occur if the
  4. \                image is saved with parms. But fixed with new: sarray clearing size.
  5. \ 11.28.90    rfl    added dialog1 class to allow enabling etc. with controls
  6. \ 12.13.91    rfl    SP added alive: and close: to dialog1
  7. \ 3.3.92    rfl    changed string 161 to 186 for not finding STRG resource
  8. \ 5.13/93    rfl    no longer detach resource in grab; also, getnew: savedlg reads
  9. \                  in sarraystrg..don't have to grab at beginning of program
  10. \ 3.15.94    rfl    added clear: size for release:
  11. \ 9.25.94    rfl    removed close: dialog1 since it was the same as close: dialog
  12. \ 10.10.94    rfl    added txtTrue txtFalse
  13.  
  14.  
  15. :CLASS dialog1 <super dialog
  16.  
  17.   :M alive: ( -- b) get: dialPtr 0 <> ;M
  18.   :M hiliteCtl: ( n item --) handle: self swap makeint call hiliteControl ;M
  19.   :M drawItem: ( item --) dup getText: self rot putText: self ;M
  20.   :M dim: { n item -- } item handle: self drop
  21.         get: itemType 4 and                            \ is it a control?
  22.         IF  n item hiliteCtl: self THEN                \ standard disable
  23.         get: itemType 16 and
  24.         IF -3 -3 inset: temprect THEN                \ is it editable text?
  25.         n 0<
  26.         IF 3 -> n                                    \ also grey out item rectangle
  27.             set: self w 11 call penMode n syspat +base call penpat
  28.              paint: temprect call penNormal
  29.         ELSE item drawItem: self                    \ redraw original item
  30.         THEN ;M
  31.  
  32.   :M enable: ( item --)   0 swap dim: self ;M
  33.   :M disable: ( item --) -1 swap dim: self ;M
  34.  
  35.   :M hideItem: ( item --) get: dialPtr swap makeint call hideDItem ;M
  36.   :M showItem: ( item --) get: dialPtr swap makeInt call showDItem ;M
  37.  
  38. ;CLASS
  39.  
  40. \ uses Pstring format (text with byte at front showing length of text)
  41. \  same as sarray, but can be read from resource. Use STG# resource, with the first element
  42. \  bogus. The number of elements of the STG# resource should equal the number of elements 
  43. \  of the savedlg object
  44. :CLASS sarrayStrg <super sarray
  45.  
  46.     int    resID
  47.     int    keepAsRsrc        \ true if want to save the info in rsrc file
  48.  
  49.   :M putResID: put: resID ;M
  50.  
  51.   :M SaveAsRsrc: true put: keepAsRsrc ;M
  52.   :M dontSaveAsRsrc: clear: keepAsRsrc ;M
  53.  
  54.   :M getnew: ( --)
  55.     get: resID 'type STG# (getres) m! m@ 0=
  56.     IF   new: self
  57.     ELSE get: self scount put: size
  58.     THEN ;M
  59.  
  60.   :M save: get: keepAsRsrc IF m@ call changedResource m@ call writeResource THEN ;M
  61.  
  62.   :M release: m@ call releaseResource 0 m! clear: size ;M
  63.  
  64. ;CLASS
  65.  
  66. :CLASS SaveDlg <super dialog1
  67.  
  68.     sarrayStrg    parms
  69.  
  70.   :M putResID: dup putResID: super putResID: parms ;M
  71.  
  72. \ doesn't save useritems, since methods are unknown...just adds place holder
  73.   :M save: clear: parms 0 0 add: parms limit 1
  74.         DO i handle: self drop get: itemType dup 4 and    \ 4=ctrlItem
  75.             IF   i get: self bin>asc add: parms drop
  76.             ELSE  $ 18 and                                \ $10 or $8=text item
  77.                  IF   i getText: self add: parms
  78.                  ELSE 0 0 add: parms                    \ any other item type, fake
  79.                  THEN
  80.             THEN
  81.         LOOP
  82.         save: parms ;M
  83.  
  84. \ doesn't handle a user item, since method of fill unknown
  85.    :M fill: limit: parms -dup
  86.         IF limit: self <> classErr" 186
  87.             limit 1
  88.             DO  i handle: self drop get: itemType dup 4 and
  89.                 IF   i at: parms asc>bin i put: self drop
  90.                 ELSE $ 18 and
  91.                     IF i  at: parms i putText: self THEN
  92.                 THEN
  93.             LOOP
  94.         THEN ;M
  95.  
  96.   :M getNew: getNew: super valid: parms not IF getNew: parms THEN fill: self ;M
  97.  
  98.   :M new: new: parms ;M
  99. \ grab a STG# resource and fill parms with it. Use in place of new.
  100. \ parms id is same as dialog
  101.   :M grab: ( --) get: resID putResID: parms getnew: parms ;M
  102.  
  103.   :M getParms: get: parms ;M
  104.   :M fillParms: ( anotherParm --) put: parms ;M
  105. \ fill an empty sarray (not new:) with IVARS of pars
  106.   :M =: { mySarray -- } addr: parms mySarray length: mySarray cmove ;M
  107.   :M atParm: ( ind -- addr len) at: parms ;M
  108.   :M toParm: ( addr len ind --) to: parms ;M
  109.   :M print: print: parms ;M
  110.  
  111.   :M closeSave: save: self close: self ;M
  112.  
  113.   :M release: release: parms clear: parms ;M
  114.  
  115.   :M lock: lock: parms ;M
  116.   :M unlock: unlock: parms ;M
  117.  
  118.   :M saveAsRsrc: saveAsRsrc: parms ;M
  119.   :M dontSaveAsRsrc: dontSaveAsRsrc: parms ;M
  120.  
  121. \ for saving and restoring parameters to disk
  122.   :M write: size: parms sp@ 4 write: topfile 2drop
  123.         lock: parms get: parms write: topfile drop unlock: parms ;M
  124.  
  125.   :M read: buf255 4 read: topfile drop
  126.         buf255 @ setsize: parmstr topfile size: parmstr read: parmstr drop
  127.         lock: parmstr get: parmstr put: parms unlock: parmstr ;M
  128.  
  129. ;CLASS
  130.  
  131. : getter save: caller closer ;
  132.  
  133. \ ascii string true...use with atParm: which returns a " 1" or " 0"
  134. : s1= " 1" s= ;
  135.  
  136. \ other useful words
  137. : txtTrue ( addr len -- b) drop c@ ascii 1 = ;
  138. : txtFalse ( addr len -- b) txtTrue not ;
  139.  
  140.